home *** CD-ROM | disk | FTP | other *** search
/ PC World 2007 March / PCWorld_2007-03_cd.bin / domacnost a kancelar / scribus / scribus-1.3.3.7-win32-install.exe / tcl / tix8.1 / SWindow.tcl < prev    next >
Text File  |  2001-12-08  |  7KB  |  275 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: SWindow.tcl,v 1.2.2.2 2001/12/09 02:54:02 idiscovery Exp $
  4. #
  5. # SWindow.tcl --
  6. #
  7. #    This file implements Scrolled Window widgets
  8. #
  9. # Copyright (c) 1993-1999 Ioi Kim Lam.
  10. # Copyright (c) 2000-2001 Tix Project Group.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16. #
  17. #
  18. # Example:
  19. #    
  20. #    tixScrolledWindow .w
  21. #    set window [.w subwidget window]
  22. #        # Now you can put a whole widget hierachy inside $window.
  23. #        #
  24. #    button $window.b
  25. #    pack $window.b
  26. #
  27. # Author's note
  28. #
  29. # Note, the current implementation does not allow the child window
  30. # to be outside of the parent window when the parent's size is larger
  31. # than the child's size. This is fine for normal operations. However,
  32. # it is not suitable for an MDI master window. Therefore, you will notice
  33. # that the MDI master window is not a subclass of ScrolledWidget at all.
  34. #
  35. #
  36.  
  37. tixWidgetClass tixScrolledWindow {
  38.     -classname TixScrolledWindow
  39.     -superclass tixScrolledWidget
  40.     -method {
  41.     }
  42.     -flag {
  43.     -expandmode -shrink -xscrollincrement -yscrollincrement
  44.     }
  45.     -static {
  46.     }
  47.     -configspec {
  48.     {-expandmode expandMode ExpandMode expand}
  49.     {-shrink shrink Shrink ""}
  50.     {-xscrollincrement xScrollIncrement ScrollIncrement ""}
  51.     {-yscrollincrement yScrollIncrement ScrollIncrement ""}
  52.  
  53.     {-scrollbarspace scrollbarSpace ScrollbarSpace {both}}
  54.     }
  55.     -default {
  56.     {.scrollbar            auto}
  57.     {*window.borderWidth        1}
  58.     {*f1.borderWidth        1}
  59.     {*Scrollbar.borderWidth        1}
  60.     {*Scrollbar.takeFocus        0}
  61.     }
  62. }
  63.  
  64. proc tixScrolledWindow:InitWidgetRec {w} {
  65.     upvar #0 $w data
  66.  
  67.     tixChainMethod $w InitWidgetRec
  68.  
  69.     set data(dx) 0
  70.     set data(dy) 0
  71. }
  72.  
  73. proc tixScrolledWindow:ConstructWidget {w} {
  74.     upvar #0 $w data
  75.     global tcl_platform
  76.  
  77.     tixChainMethod $w ConstructWidget
  78.  
  79.     set data(pw:f1) \
  80.     [frame $w.f1 -relief sunken]
  81.     set data(pw:f2) \
  82.     [frame $w.f2 -bd 0]
  83.     set data(w:window) \
  84.     [frame $w.f2.window -bd 0]
  85.     pack $data(pw:f2) -in $data(pw:f1) -expand yes -fill both
  86.  
  87.     set data(w:hsb) \
  88.     [scrollbar $w.hsb -orient horizontal -takefocus 0]
  89.     set data(w:vsb) \
  90.     [scrollbar $w.vsb -orient vertical -takefocus 0]
  91. #   set data(w:pann) \
  92. #    [frame $w.pann -bd 2 -relief groove]
  93.     
  94.     $data(pw:f1) config -highlightthickness \
  95.     [$data(w:hsb) cget -highlightthickness]
  96.  
  97.     set data(pw:client) $data(pw:f1)
  98. }
  99.  
  100. proc tixScrolledWindow:SetBindings {w} {
  101.     upvar #0 $w data
  102.  
  103.     tixChainMethod $w SetBindings
  104.  
  105.     $data(w:hsb) config -command "tixScrolledWindow:ScrollBarCB $w x"
  106.     $data(w:vsb) config -command "tixScrolledWindow:ScrollBarCB $w y"
  107.  
  108.     tixManageGeometry $data(w:window) "tixScrolledWindow:WindowGeomProc $w"
  109. }
  110.  
  111. # This guy just keeps asking for a same size as the w:window 
  112. #
  113. proc tixScrolledWindow:WindowGeomProc {w args} {
  114.     upvar #0 $w data
  115.  
  116.     set rw [winfo reqwidth  $data(w:window)]
  117.     set rh [winfo reqheight $data(w:window)]
  118.  
  119.     if {$rw != [winfo reqwidth  $data(pw:f2)] ||
  120.     $rh != [winfo reqheight $data(pw:f2)]} {
  121.     tixGeometryRequest $data(pw:f2) $rw $rh
  122.     }
  123. }
  124.  
  125. proc tixScrolledWindow:Scroll {w axis total window first args} {
  126.     upvar #0 $w data
  127.  
  128.     case [lindex $args 0] {
  129.     "scroll" {
  130.         set amt  [lindex $args 1]
  131.         set unit [lindex $args 2]
  132.  
  133.         case $unit {
  134.         "units" {
  135.             set incr $axis\scrollincrement
  136.             if {$data(-$incr) != ""} {
  137.             set by $data(-$incr)
  138.             } else {
  139.             set by [expr $window / 16]
  140.             }
  141.             set first [expr $first + $amt * $by]
  142.         }
  143.         "pages" {
  144.             set first [expr $first + $amt * $window]
  145.         }
  146.         }
  147.     }
  148.     "moveto" {
  149.         set to [lindex $args 1]
  150.         set first [expr int($to * $total)]
  151.     }
  152.     }
  153.  
  154.     if {[expr $first + $window] > $total} {
  155.     set first [expr $total - $window]
  156.     }
  157.     if {$first < 0} {
  158.     set first 0
  159.     }
  160.  
  161.     return $first
  162. }
  163.  
  164. proc tixScrolledWindow:ScrollBarCB {w axis args} {
  165.     upvar #0 $w data
  166.  
  167.     set bd \
  168.        [expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
  169.     set fw [expr [winfo width  $data(pw:f1)] - 2*$bd]
  170.     set fh [expr [winfo height $data(pw:f1)] - 2*$bd]
  171.     set ww [winfo reqwidth  $data(w:window)]
  172.     set wh [winfo reqheight $data(w:window)]
  173.  
  174.     if {$axis == "x"} {
  175.     set data(dx) \
  176.         [eval tixScrolledWindow:Scroll $w $axis $ww $fw $data(dx) $args]
  177.     } else {
  178.     set data(dy) \
  179.         [eval tixScrolledWindow:Scroll $w $axis $wh $fh $data(dy) $args]
  180.     }
  181.  
  182.     tixWidgetDoWhenIdle tixScrolledWindow:PlaceWindow $w
  183. }
  184.  
  185. proc tixScrolledWindow:PlaceWindow {w} {
  186.     upvar #0 $w data
  187.  
  188.     set bd \
  189.        [expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
  190.     set fw [expr [winfo width  $data(pw:f1)] - 2*$bd]
  191.     set fh [expr [winfo height $data(pw:f1)] - 2*$bd]
  192.     set ww [winfo reqwidth  $data(w:window)]
  193.     set wh [winfo reqheight $data(w:window)]
  194.  
  195.     tixMapWindow $data(w:window)
  196.  
  197.     if {$data(-expandmode) == "expand"} {
  198.     if {$ww < $fw} {
  199.         set ww $fw
  200.     }
  201.     if {$wh < $fh} {
  202.         set wh $fh
  203.     }
  204.     }
  205.     if {$data(-shrink) == "x"} {
  206.     if {$fw < $ww} {
  207.         set ww $fw
  208.     }
  209.     }
  210.  
  211.     tixMoveResizeWindow $data(w:window) -$data(dx) -$data(dy) $ww $wh
  212.  
  213.     set first [expr $data(dx).0 / $ww.0]
  214.     set last  [expr $first + ($fw.0 / $ww.0)]
  215.     $data(w:hsb) set $first $last
  216.  
  217.     set first [expr $data(dy).0 / $wh.0]
  218.     set last  [expr $first + ($fh.0 / $wh.0)]
  219.     $data(w:vsb) set $first $last
  220. }
  221.  
  222. #----------------------------------------------------------------------
  223. # virtual functions to query the client window's scroll requirement
  224. #
  225. # When this function is called, the scrolled window is going to be
  226. # mapped, if it is still unmapped. Also, it is going to change its
  227. # size. Therefore, it is a good time to check whether the w:window needs
  228. # to be re-positioned due to the new parent window size.
  229. #----------------------------------------------------------------------
  230. proc tixScrolledWindow:GeometryInfo {w mW mH} {
  231.     upvar #0 $w data
  232.  
  233.     set bd \
  234.        [expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
  235.     set fw [expr $mW -2*$bd]
  236.     set fh [expr $mH -2*$bd]
  237.     set ww [winfo reqwidth  $data(w:window)]
  238.     set wh [winfo reqheight $data(w:window)]
  239.  
  240.     # Calculate the X info
  241.     #
  242.     if {$fw >= $ww} {
  243.     if {$data(dx) > 0} {
  244.         set data(dx) 0
  245.     }
  246.     set xinfo [list 0.0 1.0]
  247.     } else {
  248.     set maxdx [expr $ww - $fw]
  249.     if {$data(dx) > $maxdx} {
  250.         set data(dx) $maxdx
  251.     }
  252.     set first [expr $data(dx).0 / $ww.0]
  253.     set last  [expr $first + ($fw.0 / $ww.0)]
  254.     set xinfo [list $first $last]
  255.     }
  256.     # Calculate the Y info
  257.     #
  258.     if {$fh >= $wh} {
  259.     if {$data(dy) > 0} {
  260.         set data(dy) 0
  261.     }
  262.     set yinfo [list 0.0 1.0]
  263.     } else {
  264.     set maxdy [expr $wh - $fh]
  265.     if {$data(dy) > $maxdy} {
  266.         set data(dy) $maxdy
  267.     }
  268.     set first [expr $data(dy).0 / $wh.0]
  269.     set last  [expr $first + ($fh.0 / $wh.0)]
  270.     set yinfo [list $first $last]
  271.     }
  272.  
  273.     return [list $xinfo $yinfo]
  274. }
  275.